Programmer Power Tools/Programmer Power Tools.iso/progjrn/pj_7_6.arc/ALTMON.PAS

Pascal/Delphi Source File | 1989-06-07 | 16KB | 570 lines

Unit AltMon;
{
  Overview/Description:
    AltMon provides support which allows an application to utilize two video
    monitors.  Even though it is possible, in some cases, to keep two video
    adapters on the bus, without conflict, MS-DOS and Turbo-Pascal are only
    able to utilize one at a time.

    AltMon gets around this limitation by writing directly to the video RAM
    on the idle monitor.  Normal system services on the default monitor are
    not inhibited in any fashion.  The net result is two active video
    displays.

    Most of the routines within AltMon are prefixed with an "Alt_", for
    ease in identification, and to avoid name conflicts.  All of the
    intrinsic Turbo Pascal video support routines have been implemented.

    For example, to clear the alternate display screen, simply invoke
    "Alt_ClrScr" or to position the alternate cursor, use "Alt_GotoXY(X, Y)".

    Most routines are self explanatory, but AltMon_Setup must be called
    prior to invoking any of the routines in this module.

  Compiler/Operating System:
    Turbo-Pascal Ver 5.0
    MS-DOS Ver 3.30

  Maintenance History:
    7 June, 1989    G.S.Cole    //Creation//
}
Interface

Uses DOS;

Type
  Alt_String = String[255];

  AltMon_Attribute_Type = (Alt_Normal, Alt_Intense, Alt_Underlined, Alt_Intense_Underlined,
                           Alt_Reverse, Alt_Blink, Alt_Blink_Intense, Alt_Blink_Reverse);
{.Page}
{
    Video Attribute Group.
}
Function Alt_TextAttr:Byte;
Function Alt_Get_TextAttr:AltMon_Attribute_Type;
Procedure Alt_Set_Attribute(Candidate:AltMon_Attribute_Type);
Procedure Alt_NormVideo;
Procedure Alt_HighVideo;
Procedure Alt_LowVideo;
Procedure Alt_TextBackGround(Color:Byte);
Procedure Alt_TextColor(Color:Byte);
{
    Cursor Support Group.
}
Procedure Alt_Cursor_Enable;
Procedure Alt_Cursor_Disable;
Procedure Alt_GotoXY(X, Y:Byte);
Function Alt_WhereX:Byte;
Function Alt_WhereY:Byte;
{
    Window Support Group.
}
Function Alt_WindMin:Word;
Function Alt_WindMax:Word;
Procedure Alt_Window(X1, Y1, X2, Y2:Byte);
{
    Display support.
}
Procedure Alt_ClrScr;
Procedure Alt_ClrEOL;
Procedure Alt_DelLine;
Procedure Alt_InsLine;
{
    ...And something to write with...
}
Procedure Alt_Write(Buffer:Alt_String);
Procedure Alt_Writeln(Buffer:Alt_String);
{
    Utilities
}
Function Swap_Monitor:Boolean;
Procedure AltMon_Setup;
{
    Initialization...
}
Function Dual_Monitors_Detected:Boolean;

Implementation
{.Page}
CONST
  Cursor_Attribute = $F0;
  Cursor_Character = $DB;
  Video_RAM = $B000;
  Other_Video_RAM = $B800;

  X_Max = 79;
  X_Min = 0;
  Y_Max = 24;
  Y_Min = 0;

Type
  Display_Record = Record
    C:Char; { the character to be displayed }
    A:Byte; { and it's video attribute }
  end;

  Line_Type = Array[X_Min..X_Max] of Display_Record;
  Display_Type = Array[Y_Min..Y_Max] of Line_Type;

VAR
  Display: Display_Type Absolute Video_RAM:0;
  Attribute_Type:AltMon_Attribute_Type;
  Attribute,
  Cur_X, Cur_Y,
  Cur_X_Min, Cur_Y_Min, Cur_X_Max, Cur_Y_Max:Byte;
  Cursor_Enable_Flag:Boolean;

Procedure Post_Cursor;
{
    Called after moving cursor, ensures (if enabled) a cursor is present.
}
begin { Procedure Post_Cursor }
  If Cursor_Enable_Flag then
    begin
      If Display[Cur_Y, Cur_X].C = ' '
        then Display[Cur_Y, Cur_X].C := Chr(Cursor_Character);
      Display[Cur_Y, Cur_X].A := Cursor_Attribute;
    end;
end; { Procedure Post_Cursor }

Procedure Pre_Cursor;
{
    Invoked prior to moving cursor, ensures it is totally deleted.
}
begin { Procedure Pre_Cursor }
  If Cursor_Enable_Flag then
    begin
      If Display[Cur_Y, Cur_X].C = Chr(Cursor_Character)
        then Display[Cur_Y, Cur_X].C := ' ';
      Display[Cur_Y, Cur_X].A := Attribute;
    end;
end; { Procedure Pre_Cursor }
{.Page}
Procedure Check_4_Scroll;
{
    Determine if vertical scrolling is required, and if so, perform it.
    Scrolling is performed against the logical window boundaries, not
    the physical limits of the display.
}
var
  X, Y:Byte;
begin { Procedure Check_4_Scroll }
  if Cur_Y > Cur_Y_Max then
    begin
      For Y := Cur_Y_Min to Pred(Cur_Y_Max) do        { bump lines up one }
        Move(Display[Y+1, Cur_X_Min], Display[Y, Cur_X_Min], (Succ(Cur_X_Max-Cur_X_Min)*2));
      For X := Cur_X_Min to Cur_X_Max do              { clear off bottom line }
        begin
          Display[Cur_Y_Max, X].C := ' ';
          Display[Cur_Y_Max, X].A := Attribute;
        end;
      Cur_Y := Cur_Y_Max;
    end;
  Post_Cursor;
end; { Procedure Check_4_Scroll }
{.Page}
Procedure Check_4_CRLF;
{
    Determine if the end of line has been exceeded.
    If so, wrap to the next line, scrolling if required.
}
begin { Procedure Check_4_CRLF }
  If Cur_X > Cur_X_Max then
    begin
      Cur_X := Cur_X_Min;
      Cur_Y := Succ(Cur_Y);
      Check_4_Scroll;
    end;
  Post_Cursor;
end; { Procedure Check_4_CRLF }

Procedure Service_Control_Character(C:Char);
{
    Perform special handling to support the legal control characters.
}
begin { Procedure Service_Control_Character }
  Case C of
    ^G:Write(^G);  { Bell }
    ^H:begin       { Backspace }
         If Cur_X > Cur_X_Min then
           begin
             Pre_Cursor;
             Cur_X := Pred(Cur_X);
             Post_Cursor;
           end;
       end;
    ^J:begin       { Line Feed }
        Pre_Cursor;
        Cur_Y := Succ(Cur_Y);
        Check_4_Scroll;
       end;
    ^M:begin       { Carriage Return }
         Pre_Cursor;
         Cur_X := Cur_X_Min;
         Post_Cursor;
       end;
  end; { case }
end; { Procedure Service_Control_Character }
{.Page}
Function Alt_TextAttr:Byte;
{
    Return the current alternate monitor attribute.
    Note that this differs from the Turbo Pascal implementation in that
    this is a function, and cannot be written to (TextAttr is a variable).
    You can manually set video attributes via Alt_TextBackGround and
    Alt_TextColor.
}
begin { Function Alt_TextAttr }
  Alt_TextAttr := Attribute;
end; { Function Alt_TextAttr }

Function Alt_Get_TextAttr:AltMon_Attribute_Type;
{
    Return the current alternate monitor attribute types.

    There is not an equivalent intrinsic Turbo Pascal procedure.
}
begin { Function Alt_Get_TextAttr }
  Alt_Get_TextAttr := Attribute_Type;
end; { Function Alt_Get_TextAttr }

Procedure Alt_Set_Attribute(Candidate:AltMon_Attribute_Type);
{
    Define the current video attribute.  Note that these are set with
    typed variables, rather than specifying the bit definitions.

    There is not an equivalent intrinsic Turbo Pascal procedure.
}
begin { Procedure Alt_Set_Typed_Attribute }
  Attribute_Type := Candidate;
  Case Candidate of
    Alt_Normal:     Attribute := 7;
    Alt_Intense:    Attribute := 15;
    Alt_Underlined: Attribute := 1;
    Alt_Intense_Underlined: Attribute := 9;
    Alt_Reverse:    Attribute := 112;
    Alt_Blink:      Attribute := 135;
    Alt_Blink_Intense: Attribute := 143;
    Alt_Blink_Reverse: Attribute := 240;
  end;
end; { Procedure Alt_Set_Attribute }
{.Page}
Procedure Alt_NormVideo;
{
    Set the normal video attributes.
}
begin { Procedure Alt_NormVideo }
  Alt_Set_Attribute(Alt_Normal);
end; { Procedure Alt_NormVideo }

Procedure Alt_HighVideo;
{
    Set highlighted (intense) attributes.
}
begin { Procedure Alt_HighVideo }
  Alt_Set_Attribute(Alt_Intense);
end; { Procedure Alt_HighVideo }

Procedure Alt_LowVideo;
{
    My tests show that this is the same video attributes as NormVideo.
}
begin { Procedure Alt_LowVideo }
  Alt_NormVideo;
end; { Procedure Alt_LowVideo }

Procedure Alt_TextBackGround(Color:Byte);
{
    Insert a new background color into the attribute mask.
}
begin { Procedure Alt_TextBackGround }
  Color := (Color and 7)*16;       { mask background, position for insertion }
  Attribute := Attribute and $8F;  { mask background }
  Attribute := Attribute or Color;
end; { Procedure Alt_TextBackGround }

Procedure Alt_TextColor(Color:Byte);
{
    Insert a new text color into the attribute mask.
    Blinking enabled, if leading bit set.
}
begin { Procedure Alt_TextColor }
  Color := Color and $1F;          { mask background, leave blink bit }
  Attribute := Attribute and $70;  { mask foreground, and blink bit }
  Attribute := Attribute or Color; { new result }
end; { Procedure Alt_TextColor }
{.Page}
Procedure Alt_ClrScr;
{
    "Clear" the alternate display by setting the video attributes to normal,
    and padding it out with ASCII spaces.
    Exits w/cursor "homed" - respects the logical window definitions.
}
VAR
  X, Y:Byte;
begin { Procedure Alt_ClrScr }
  For X := Cur_X_Min to Cur_X_Max do              { clear off top line }
    begin
      Display[Cur_Y_Min, X].C := ' ';
      Display[Cur_Y_Min, X].A := Attribute;
    end;
  For Y := Cur_Y_Min to Pred(Cur_Y_Max) do        { and copy on down... }
    Move(Display[Y, Cur_X_Min], Display[Y+1, Cur_X_Min], (Succ(Cur_X_Max-Cur_X_Min)*2));
  Cur_X := Cur_X_Min;
  Cur_Y := Cur_Y_Min;
  Post_Cursor;
end; { Procedure Alt_ClrScr }

Procedure Alt_ClrEOL;
{
    Clear the current line, from the current cursor position to end,
    without altering the current cursor location.
}
VAR
  X:Byte;
begin { Procedure Alt_ClrEOL }
  For X := Cur_X to Cur_X_Max do
    begin
      Display[Cur_Y, X].C := ' ';
      Display[Cur_Y, X].A := Attribute;
    end;
  Post_Cursor;
end; { Procedure Alt_ClrEOL }

Procedure Alt_Cursor_Enable;
{
    Enable the pseudo cursor on the alternate display.
}
begin { Procedure Alt_Cursor_Enable }
  Cursor_Enable_Flag := True;
  Post_Cursor;
end; { Procedure Alt_Cursor_Enable }

Procedure Alt_Cursor_Disable;
{
    Disable the psuedo cursor on the alternate display.
}
begin { Procedure Alt_Cursor_Disable }
  Pre_Cursor;
  Cursor_Enable_Flag := False;
end; { Procedure Alt_Cursor_Disable }
{.Page}
Procedure Alt_GotoXY(X, Y:Byte);
{
    Position the pseudo-cursor.  Note that the coordinates are window
    relative, and if invalid, the cursor isn't moved.
}
begin { Procedure Alt_GotoXY }
  X := Pred(X);  { Ref to 0, 0 }
  Y := Pred(Y);
  If (X <= Cur_X_Max) or (Y <= Cur_Y_Max) then
    begin
      Pre_Cursor;
      Cur_X := X + Cur_X_Min;
      Cur_Y := Y + Cur_Y_Min;
      Post_Cursor;
    end;
end; { Procedure Alt_GotoXY }

Function Alt_WhereX:Byte;
{
    Return the X coordinate of the cursor.
    Reported position is window relative.
}
begin { Function Alt_WhereX }
  Alt_WhereX := Succ(Cur_X - Cur_X_Min);
end; { Function Alt_WhereX }

Function Alt_WhereY:Byte;
{
    Return the Y coordinate of the cursor.
    Reported position is window relative.
}
begin { Function Alt_WhereY }
  Alt_WhereY := Succ(Cur_Y - Cur_Y_Min);
end; { Function Alt_WhereY }

Function Alt_WindMin:Word;
{
    Return the current upper left corner window coordinates, as packed value.
}
begin { Function Alt_WindMin }
  Alt_WindMin := Cur_Y_Min * 256 + Cur_X_Min;
end; { Function Alt_WindMin }

Function Alt_WindMax:Word;
{
    Return the current lower right corner window coordinates, as packed value.
}
begin { Function Alt_WindMax }
  Alt_WindMax := Cur_Y_Max * 256 + Cur_X_Max;
end; { Function Alt_WindMax }
{.Page}
Procedure Alt_DelLine;
{
    Delete the line at the current cursor location, and scroll up the lines
    underneath it.
}
VAR
  X, Y:Byte;
begin { Procedure Alt_DelLine }
  Pre_Cursor;
  For Y := Cur_Y to Pred(Cur_Y_Max) do
    Move(Display[Y+1, Cur_X_Min], Display[Y, Cur_X_Min], (Succ(Cur_X_Max-Cur_X_Min)*2));
  For X := Cur_X_Min to Cur_X_Max do              { clear off bottom line }
    begin
      Display[Cur_Y_Max, X].C := ' ';
      Display[Cur_Y_Max, X].A := Attribute;
    end;
  Post_Cursor;
end; { Procedure Alt_DelLine }

Procedure Alt_InsLine;
{
    Insert a line at the current cursor location.  What this really means
    is bump all the lines down, and clear the current line.
}
VAR
  X, Y:Byte;
begin { Procedure Alt_InsLine }
  Pre_Cursor;
  For Y := Pred(Cur_Y_Max) downto Cur_Y do
    Move(Display[Y, Cur_X_Min], Display[Y+1, Cur_X_Min], (Succ(Cur_X_Max-Cur_X_Min)*2));

  For X := Cur_X_Min to Cur_X_Max do              { clear off current line }
    begin
      Display[Cur_Y, X].C := ' ';
      Display[Cur_Y, X].A := Attribute;
    end;

  Cur_X := Cur_X_Min;
  Post_Cursor;
end; { Procedure Alt_InsLine }
{.Page}
Procedure Alt_Window(X1, Y1, X2, Y2:Byte);
{
    Define a portion of the alternate display as the current window.
    All display coordinates will be reference to the new logical coordinates.
    Exits w/cursor "homed".
}
begin { Procedure Alt_Window }
  Pre_Cursor;
  Cur_X_Min := Pred(X1);
  Cur_Y_Min := Pred(Y1);
  Cur_X_Max := Pred(X2);
  Cur_Y_Max := Pred(Y2);
  Cur_X := Cur_X_Min;
  Cur_Y := Cur_Y_Min;
  Post_Cursor;
end; { Procedure Alt_Window }

Procedure Alt_Write(Buffer:Alt_String);
{
    Write a line of data to the display.
}
VAR
  I:Byte;
begin { Procedure Alt_Write }
  Pre_Cursor;
  Check_4_Scroll;
  For I := 1 to Length(Buffer) do
    begin
      If Buffer[I] < ' '
        then Service_Control_Character(Buffer[I])
        else begin
          Display[Cur_Y, Cur_X].C := Buffer[I];
          Display[Cur_Y, Cur_X].A := Attribute;
          Cur_X := Succ(Cur_X);
          Check_4_CRLF;
        end;
    end;
end; { Procedure Alt_Write }
{.Page}
Procedure Alt_Writeln(Buffer:Alt_String);
{
    Write a line of data to the display, followed by a CR/LF sequence.
}
begin { Procedure Alt_Writeln }
  Buffer := Buffer + ^M + ^J;
  Alt_Write(Buffer);
end; { Procedure Alt_Writeln }

Function Dual_Monitors_Detected:Boolean;
{
    Determine if two video adapters are present on the buss.  This is
    accomplished by writing to the origin of both the monochrome and
    color video display pages.  If I'm allowed to change the contents
    of these memory locations, then two video adapters are probably
    present, and TRUE is returned.
}
VAR
  C:Byte;
begin { Function Dual_Monitors_Detected }
  C := MEM[Video_RAM:0];
  MEM[Video_RAM:0] := Succ(C);
  If C <> MEM[Video_RAM:0] then
    begin
      MEM[Video_RAM:0] := C;
      C := MEM[Other_Video_RAM:0];
      MEM[Other_Video_RAM:0] := Succ(C);
      If C = MEM[Other_Video_RAM:0]
        then Dual_Monitors_Detected := False
        else begin
          MEM[Other_Video_RAM:0] := C;
          Dual_Monitors_Detected := True;
        end;
    end
    else Dual_Monitors_Detected := False;
end; {Function Dual_Monitors_Detected }
{.Page}
Function Swap_Monitor:Boolean;
{
    Swap the active display.
    If current display is monochrome, make it color, and return true.
    If current display is color, make it monochrome, and return false.
}
CONST
  Video_Interrupt = $10;
  Equipment_List_Offset = $410;
VAR
  Regs:Registers;
  X:Byte;
begin { Function Swap_Monitor }
  Regs.AH := $0F;     { Determine Video Mode }
  INTR(Video_Interrupt, Regs);
  X := MEM[0:Equipment_List_Offset];
  If Regs.AL = 7 then { Mono Mode? }
    begin  { Set Color Mode }
      X := X AND $CF;
      Regs.AL := 3;
      Swap_Monitor := True;
    end
  else
    begin  { Set Mono Mode }
      X := X OR $30;
      Regs.AL := 7;
      Swap_Monitor := False;
    end;
  MEM[0:Equipment_List_Offset] := X;
  Regs.AH := 0;       { Set Video Mode }
  INTR(Video_Interrupt, Regs);
end; { Function Swap_Monitor }

Procedure AltMon_Setup;
{
  Prepare to use the AltMon module by initializing variables, and clearing
    the alternate display.
}
begin { Procedure AltMon_Setup }
  Alt_NormVideo;
  Cur_X_Min := X_Min;
  Cur_Y_Min := Y_Min;
  Cur_X_Max := X_Max;
  Cur_Y_Max := Y_Max;
  Alt_ClrScr;
  Alt_Cursor_Enable;
end; { Procedure AltMon_Setup }

end. { Unit AltMon }